Import data
df_coop_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/coop_ratio/*.csv"), read_csv))
df_coop_max <- do.call(rbind, lapply(Sys.glob("../*max/data/coop_ratio/*.csv"), read_csv))
df_coop_min <- do.call(rbind, lapply(Sys.glob("../*min/data/coop_ratio/*.csv"), read_csv))
full <- df_coop_homo %>%
rbind(df_coop_max) %>%
rbind(df_coop_min) %>%
mutate(tournament_type = case_when(
tournament_type == "pareto_m_min" ~ "pareto_m_max",
tournament_type == "pareto_dr_min" ~ "pareto_dr_max",
tournament_type == "pareto_mdr_min" ~ "pareto_mdr_max",
tournament_type == "pareto_m_max" ~ "pareto_m_min",
tournament_type == "pareto_dr_max" ~ "pareto_dr_min",
tournament_type == "pareto_mdr_max" ~ "pareto_mdr_min",
TRUE ~ as.character(tournament_type))
)
rm(df_coop_homo,df_coop_max,df_coop_min)
Analysis of cooperation ratio
full %>%
group_by(tournament_type, seed) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
ggplot(aes(x = as.factor(tournament_type), y = mean_coop, fill = tournament_type)) +
geom_bar(stat="identity") +
geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
facet_wrap(~seed) +
coord_flip() +
scale_fill_grey(guide = F) +
labs(title = "Mean cooperation ratio and standard deviation per tournament type, facetted by seed",
y = "cooperatio ratio",
x = " ")
full %>%
group_by(tournament_type, seed) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
ggplot(aes(x = as.factor(seed), y = mean_coop, fill = tournament_type)) +
geom_bar(stat="identity") +
geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
facet_wrap(~tournament_type) +
coord_flip() +
scale_fill_grey(guide = F) +
labs(title = "Mean cooperation ratio and standard deviation per seed, facetted by tournament type",
y = "cooperatio ratio",
x = " ")
full %>%
group_by(tournament_type) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
arrange(desc(mean_coop)) %>%
kable(caption = "Tournament types arranged by mean of cooperation ratio") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| tournament_type | mean_coop | sd_coop |
|---|---|---|
| hetero_dr_sd_max | 0.6002804 | 0.1605549 |
| homogenous | 0.5892130 | 0.1542594 |
| pareto_m_min | 0.5886649 | 0.1566004 |
| hetero_m_sd_max | 0.5859083 | 0.1568820 |
| pareto_mdr_min | 0.5825757 | 0.1616499 |
| hetero_mdr_sd_max | 0.5817933 | 0.1660426 |
| hetero_m_sd_min | 0.5799698 | 0.1605414 |
| pareto_dr_min | 0.5795952 | 0.1543603 |
| hetero_mdr_sd_min | 0.5793128 | 0.1596192 |
| hetero_dr_sd_min | 0.5789166 | 0.1612046 |
| pareto_m_max | 0.5747713 | 0.1575829 |
| pareto_mdr_max | 0.5715410 | 0.1618162 |
| pareto_dr_max | 0.5713618 | 0.1638552 |
full %>%
group_by(tournament_type) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
arrange(desc(sd_coop)) %>%
kable(caption = "Tournament types arranged by s.d. of cooperation ratio") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| tournament_type | mean_coop | sd_coop |
|---|---|---|
| hetero_mdr_sd_max | 0.5817933 | 0.1660426 |
| pareto_dr_max | 0.5713618 | 0.1638552 |
| pareto_mdr_max | 0.5715410 | 0.1618162 |
| pareto_mdr_min | 0.5825757 | 0.1616499 |
| hetero_dr_sd_min | 0.5789166 | 0.1612046 |
| hetero_dr_sd_max | 0.6002804 | 0.1605549 |
| hetero_m_sd_min | 0.5799698 | 0.1605414 |
| hetero_mdr_sd_min | 0.5793128 | 0.1596192 |
| pareto_m_max | 0.5747713 | 0.1575829 |
| hetero_m_sd_max | 0.5859083 | 0.1568820 |
| pareto_m_min | 0.5886649 | 0.1566004 |
| pareto_dr_min | 0.5795952 | 0.1543603 |
| homogenous | 0.5892130 | 0.1542594 |
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_dr_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_m_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_mdr_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_dr_sd_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_m_sd_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_mdr_sd_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_dr_sd_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_m_sd_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_mdr_sd_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_dr_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_m_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_mdr_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
Data Prep
Data import
my_formula <- y ~ x
df_outliers_full %>%
ggplot() +
geom_point(aes(S.D., Counts, color = as.factor(seed))) +
geom_smooth(aes(S.D., Counts), color = "black") +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Smooth function applied to count of outliers on standard deviation",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
filter(S.D. <= 1.5) %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
subtitle = "Range of S.D. limited from 0 to 1.5",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
filter(S.D. >= 1.5) %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
subtitle = "Range of S.D. limited from 1.5 to 3",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Intercept)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| pareto_dr_min | 318.9619 | -124.5255 | 0.9151360 |
| control_group | 313.9496 | -121.9624 | 0.9149856 |
| pareto_m_min | 309.6571 | -120.7227 | 0.9116794 |
| norm_m_sd_max | 305.0884 | -118.9032 | 0.9102347 |
| norm_mdr_sd_min | 304.7535 | -119.0130 | 0.9043898 |
| pareto_mdr_max | 300.6716 | -117.2629 | 0.9114020 |
| pareto_m_max | 299.2762 | -116.3644 | 0.9159300 |
| norm_dr_sd_min | 295.8781 | -115.0315 | 0.9208328 |
| pareto_dr_max | 295.6928 | -115.4574 | 0.9107716 |
| norm_m_sd_min | 294.6364 | -114.5549 | 0.9221166 |
| pareto_mdr_min | 293.8838 | -114.2017 | 0.9117865 |
| norm_dr_sd_max | 293.4010 | -114.0533 | 0.9138033 |
| norm_mdr_sd_max | 290.0874 | -112.9884 | 0.9226192 |
df_outliers_full %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Slope)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| norm_mdr_sd_max | 290.0874 | -112.9884 | 0.9226192 |
| norm_dr_sd_max | 293.4010 | -114.0533 | 0.9138033 |
| pareto_mdr_min | 293.8838 | -114.2017 | 0.9117865 |
| norm_m_sd_min | 294.6364 | -114.5549 | 0.9221166 |
| norm_dr_sd_min | 295.8781 | -115.0315 | 0.9208328 |
| pareto_dr_max | 295.6928 | -115.4574 | 0.9107716 |
| pareto_m_max | 299.2762 | -116.3644 | 0.9159300 |
| pareto_mdr_max | 300.6716 | -117.2629 | 0.9114020 |
| norm_m_sd_max | 305.0884 | -118.9032 | 0.9102347 |
| norm_mdr_sd_min | 304.7535 | -119.0130 | 0.9043898 |
| pareto_m_min | 309.6571 | -120.7227 | 0.9116794 |
| control_group | 313.9496 | -121.9624 | 0.9149856 |
| pareto_dr_min | 318.9619 | -124.5255 | 0.9151360 |
df_outliers_full %>%
filter(S.D. <= 2) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
mutate(Var = -Intercept/Slope) %>%
arrange(Var) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 | Var |
|---|---|---|---|---|
| norm_m_sd_max | 363.3324 | -169.1309 | 0.9643471 | 2.148232 |
| norm_mdr_sd_min | 362.6412 | -168.7279 | 0.9541591 | 2.149266 |
| pareto_dr_max | 349.6566 | -161.9103 | 0.9529084 | 2.159570 |
| pareto_m_max | 354.8750 | -164.2500 | 0.9712504 | 2.160578 |
| pareto_dr_min | 375.8412 | -173.1779 | 0.9652927 | 2.170260 |
| pareto_m_min | 364.4471 | -167.6676 | 0.9524959 | 2.173628 |
| pareto_mdr_max | 353.1904 | -162.3074 | 0.9457772 | 2.176059 |
| pareto_mdr_min | 345.8625 | -158.9000 | 0.9481187 | 2.176605 |
| norm_dr_sd_max | 343.8375 | -157.2000 | 0.9508106 | 2.187261 |
| control_group | 366.5375 | -166.9000 | 0.9490888 | 2.196150 |
| norm_dr_sd_min | 342.9221 | -155.1676 | 0.9504934 | 2.210010 |
| norm_mdr_sd_max | 336.2353 | -152.0632 | 0.9655064 | 2.211154 |
| norm_m_sd_min | 341.5154 | -154.4324 | 0.9585277 | 2.211424 |
df_outliers_full %>%
filter(S.D. <= 2) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Slope)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| norm_mdr_sd_max | 336.2353 | -152.0632 | 0.9655064 |
| norm_m_sd_min | 341.5154 | -154.4324 | 0.9585277 |
| norm_dr_sd_min | 342.9221 | -155.1676 | 0.9504934 |
| norm_dr_sd_max | 343.8375 | -157.2000 | 0.9508106 |
| pareto_mdr_min | 345.8625 | -158.9000 | 0.9481187 |
| pareto_dr_max | 349.6566 | -161.9103 | 0.9529084 |
| pareto_mdr_max | 353.1904 | -162.3074 | 0.9457772 |
| pareto_m_max | 354.8750 | -164.2500 | 0.9712504 |
| control_group | 366.5375 | -166.9000 | 0.9490888 |
| pareto_m_min | 364.4471 | -167.6676 | 0.9524959 |
| norm_mdr_sd_min | 362.6412 | -168.7279 | 0.9541591 |
| norm_m_sd_max | 363.3324 | -169.1309 | 0.9643471 |
| pareto_dr_min | 375.8412 | -173.1779 | 0.9652927 |
df_slope_intercept <- df_outliers_full %>%
filter(S.D. <= 2) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
mutate(Var = -Intercept/Slope) %>%
select(tournament_type = `as.factor(tournament_type)`, everything()) %>%
right_join(df_outliers_full)
df_slope_intercept %>%
mutate(Intercept = round(Intercept, 0),
Slope = round(Slope, 0),
Var = round(Var, 2)) %>%
mutate(Formula = str_c("alpha:", Intercept, "m:", Slope, "v:", Var, sep = " ")) %>%
ggplot() +
geom_point(aes(S.D., Counts, color = as.factor(seed))) +
geom_abline(aes(intercept = Intercept, slope = Slope)) +
geom_hline(yintercept = 0) +
geom_text(aes(2.2, 300, label = Formula), size = 2.5) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
subtitle = "Slope calculated for S.D. < 2",
x = "standard deviation",
y = "count of outliers")